importKeys,
makeImportMatcher,
getImportableContents,
+ PostExportLogUpdate,
) where
import Annex.Common
#ifdef mingw32_HOST_OS
import qualified System.FilePath.Posix as Posix
#endif
+import qualified Data.Semigroup as Sem
+import Prelude
{- Configures how to build an import tree. -}
data ImportTreeConfig
-> ImportCommitConfig
-> AddUnlockedMatcher
-> Imported
+ -> PostExportLogUpdate
-> Annex (Maybe Ref)
-buildImportCommit remote importtreeconfig importcommitconfig addunlockedmatcher imported =
+buildImportCommit remote importtreeconfig importcommitconfig addunlockedmatcher imported postexportlogupdate =
case importCommitTracking importcommitconfig of
Nothing -> go Nothing
Just trackingcommit -> inRepo (Git.Ref.tree trackingcommit) >>= \case
Just _ -> go (Just trackingcommit)
where
go trackingcommit = do
- (importedtree, updatestate) <- recordImportTree remote importtreeconfig (Just addunlockedmatcher) imported
+ (importedtree, updatestate) <- recordImportTree remote importtreeconfig (Just addunlockedmatcher) imported postexportlogupdate
buildImportCommit' remote importcommitconfig trackingcommit importedtree >>= \case
Just finalcommit -> do
updatestate
return (Just finalcommit)
- Nothing -> return Nothing
+ Nothing -> do
+ postExportLogUpdate postexportlogupdate
+ return Nothing
{- Builds a tree for an import from a special remote.
-
-> ImportTreeConfig
-> Maybe AddUnlockedMatcher
-> Imported
+ -> PostExportLogUpdate
-> Annex (History Sha, Annex ())
-recordImportTree remote importtreeconfig addunlockedmatcher imported = do
+recordImportTree remote importtreeconfig addunlockedmatcher imported postexportlogupdate = do
importedtree@(History finaltree _) <- buildImportTrees basetree subdir addunlockedmatcher imported
return (importedtree, updatestate finaltree)
where
{ oldTreeish = exportedTreeishes oldexport
, newTreeish = importedtree
}
+ postExportLogUpdate postexportlogupdate
return oldexport
-- importKeys takes care of updating the location log
where
ia = Remote.importActions remote
--- Result of an import. ImportUnfinished indicates that some file failed to
--- be imported. Running again should resume where it left off.
+-- Result of an import.
data ImportResult t
- = ImportFinished t
+ = ImportFinished PostExportLogUpdate t
| ImportUnfinished
+ -- ^ ImportUnfinished indicates that some file failed to
+ -- be imported. Running again should resume where it left off.
+
+-- An action to run after the export log has been updated to reflect an
+-- import.
+newtype PostExportLogUpdate = PostExportLogUpdate (Annex ())
+
+instance Sem.Semigroup PostExportLogUpdate where
+ PostExportLogUpdate a <> PostExportLogUpdate b =
+ PostExportLogUpdate (a >> b)
+
+noPostExportLogUpdate :: PostExportLogUpdate
+noPostExportLogUpdate = PostExportLogUpdate (return ())
+
+postExportLogUpdate :: PostExportLogUpdate -> Annex ()
+postExportLogUpdate (PostExportLogUpdate a) = a
data Diffed t
= DiffChanged t
Nothing -> fullimport currcidtree
Just lastimportedtree -> diffimport cidtreemap prevcidtree currcidtree lastimportedtree
where
- remember = recordContentIdentifierTree (Remote.uuid remote)
+ -- Record the content identifier tree after the export log is
+ -- updated for the import.
+ remember = PostExportLogUpdate .
+ recordContentIdentifierTree (Remote.uuid remote)
-- In order to use a diff, the previous ContentIdentifier tree must
-- not have been garbage collected. Which can happen since there
)
fullimport currcidtree =
- importKeys remote importtreeconfig importcontent thirdpartypopulated importablecontents >>= \case
- ImportUnfinished -> return ImportUnfinished
- ImportFinished r -> do
- remember currcidtree
- return $ ImportFinished $ ImportedFull r
+ importKeys remote importtreeconfig importcontent thirdpartypopulated importablecontents >>= return . \case
+ ImportUnfinished -> ImportUnfinished
+ ImportFinished a r ->
+ ImportFinished (a <> remember currcidtree) $
+ ImportedFull r
diffimport cidtreemap prevcidtree currcidtree lastimportedtree = do
(diff, cleanup) <- inRepo $ Git.DiffTree.diffTreeRecursive
ImportUnfinished -> do
void $ liftIO cleanup
return ImportUnfinished
- ImportFinished (ImportableContentsComplete ic') ->
- liftIO cleanup >>= \case
- False -> return ImportUnfinished
- True -> do
- remember currcidtree
- return $ ImportFinished $
- ImportedDiff lastimportedtree
- (mkdiff ic' removed)
+ ImportFinished a (ImportableContentsComplete ic') ->
+ liftIO cleanup >>= return . \case
+ False -> ImportUnfinished
+ True -> ImportFinished (a <> remember currcidtree) $
+ ImportedDiff lastimportedtree
+ (mkdiff ic' removed)
-- importKeys is not passed ImportableContentsChunked
-- above, so it cannot return it
- ImportFinished (ImportableContentsChunked {}) -> error "internal"
+ ImportFinished _ (ImportableContentsChunked {}) -> error "internal"
isremoval ti = Git.DiffTree.dstsha ti `elem` nullShas
ImportableContentsComplete ic ->
go False largematcher cidmap importing db ic >>= return . \case
Nothing -> ImportUnfinished
- Just v -> ImportFinished $ ImportableContentsComplete v
+ Just v -> ImportFinished noPostExportLogUpdate $ ImportableContentsComplete v
ImportableContentsChunked {} -> do
c <- gochunked db (importableContentsChunk importablecontents)
gohistory largematcher cidmap importing db (importableHistoryComplete importablecontents) >>= return . \case
Nothing -> ImportUnfinished
- Just h -> ImportFinished $ ImportableContentsChunked
+ Just h -> ImportFinished noPostExportLogUpdate $ ImportableContentsChunked
{ importableContentsChunk = c
, importableHistoryComplete = h
}
, Remote.name remote
, ". Re-run command to resume import."
]
- ImportFinished imported -> void $
- includeCommandAction $
- commitimport imported
+ ImportFinished postexportlogupdate imported ->
+ void $ includeCommandAction $
+ commitimport imported postexportlogupdate
where
importmessages'
| null importmessages = ["import from " ++ Remote.name remote]
, err
]
-commitRemote :: Remote -> Branch -> RemoteTrackingBranch -> Maybe Sha -> ImportTreeConfig -> ImportCommitConfig -> AddUnlockedMatcher -> Imported -> CommandStart
-commitRemote remote branch tb trackingcommit importtreeconfig importcommitconfig addunlockedmatcher imported =
+commitRemote :: Remote -> Branch -> RemoteTrackingBranch -> Maybe Sha -> ImportTreeConfig -> ImportCommitConfig -> AddUnlockedMatcher -> Imported -> PostExportLogUpdate -> CommandStart
+commitRemote remote branch tb trackingcommit importtreeconfig importcommitconfig addunlockedmatcher imported postexportlogupdate =
starting "update" ai si $ do
- importcommit <- buildImportCommit remote importtreeconfig importcommitconfig addunlockedmatcher imported
+ importcommit <- buildImportCommit remote importtreeconfig importcommitconfig addunlockedmatcher imported postexportlogupdate
next $ updateremotetrackingbranch importcommit
where
ai = ActionItemOther (Just $ UnquotedString $ fromRef $ fromRemoteTrackingBranch tb)
{- git-annex import logs
-
- - Copyright 2023 Joey Hess <id@joeyh.name>
+ - Copyright 2023-2025 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
import Git.Types
import Git.Sha
import Logs.File
+import Logs.Export
import qualified Data.ByteString.Lazy as L
+import qualified Data.ByteString.Char8 as S8
+import qualified Data.Set as S
{- Records the sha of a tree that contains hashes of ContentIdentifiers
- - that were imported from a remote. -}
+ - that were imported from a remote.
+ -
+ - The sha is on the first line of the log file, and following it
+ - is a line with the the currently exported treeishs, and then a line with
+ - the incomplete exported treeishes.
+ -}
recordContentIdentifierTree :: UUID -> Sha -> Annex ()
recordContentIdentifierTree u t = do
l <- calcRepo' (gitAnnexImportLog u)
- writeLogFile l (fromRef t)
+ exported <- getExport u
+ writeLogFile l $ unlines
+ [ fromRef t
+ , unwords $ map fromRef $ exportedTreeishes exported
+ , unwords $ map fromRef $ incompleteExportedTreeishes exported
+ ]
-{- Gets the tree last recorded for a remote. -}
+{- Gets the ContentIdentifier tree last recorded for a remote.
+ -
+ - This returns Nothing if no tree was recorded yet.
+ -
+ - It also returns Nothing when there have been changes to what is exported
+ - to the remote since the tree was recorded. That avoids a problem where
+ - diffing from the current Contentidentifier tree to the previous tree
+ - would miss changes that were made to a remote by an export, but were
+ - later undone manually. For example, if a file was exported to the remote,
+ - and then the file was manually removed from the remote, the current tree
+ - would not contain the file, and neither would the previous tree.
+ - So diffing between the trees would miss that removal. The removed
+ - file would then remain in the imported tree.
+ -}
getContentIdentifierTree :: UUID -> Annex (Maybe Sha)
getContentIdentifierTree u = do
l <- calcRepo' (gitAnnexImportLog u)
-- This is safe because the log file is written atomically.
- calcLogFileUnsafe l Nothing update
+ ls <- calcLogFileUnsafe l [] (\v ls -> L.toStrict v : ls)
+ exported <- getExport u
+ return $ case reverse ls of
+ -- Subsequent lines are ignored. This leaves room for future
+ -- expansion of what is logged.
+ (a:b:c:_) -> do
+ t <- extractSha a
+ exportedtreeishs <- mapM extractSha (S8.words b)
+ incompleteexportedtreeishs <- mapM extractSha (S8.words c)
+ if same exportedtreeishs (exportedTreeishes exported) &&
+ same incompleteexportedtreeishs (incompleteExportedTreeishes exported)
+ then Just t
+ else Nothing
+ _ -> Nothing
where
- update l Nothing = extractSha (L.toStrict l)
- -- Subsequent lines are ignored. This leaves room for future
- -- expansion of what is logged.
- update _l (Just l) = Just l
+ same l1 l2 = S.fromList l1 == S.fromList l2
projects / git-annex.git / commitdiff